unit fpscounters;

{*
Independent but accurate and easy to use FPS (Frame Per Second) Counter with built in frame Count limiter.

Example usage in OpenGl:

Fps.Limit := 20;

procedure DisplayWindow; cdecl;
begin
  ...
  Fps.Tic;
  Font.OutTextXY(10,10,IntToStr(Fps.Effective)+' fps');
  ...
  glutSwapBuffers;
end;

Always use it after handling mouse, otherwise mouse may lag
TODO: default delay change is now 2ms, when initial FPS is 50 and you want 20, it took few seconds to get to 20fps, perhaps it should change delay time progresively so we get 20fps faster
}

interface

uses SysUtils, debugs;

type
  TFps = class
  private
    FFirstTime: TDateTime;
    FLastTime: TDateTime;
    FLastLastTime: TDateTime;
    FLastEffective: integer;
    FCurrent: real;
    FEffective: integer;
    FFrames: integer;
    FDuration: integer;
    FLimitDelay: integer;
    FLimitLastEffective: integer;
    FStartTime: TDateTime;
    procedure NoTic;
  public
    Limit: integer; // maximal FPS

    constructor Create; virtual;
    procedure Tic; // call this after each frame is displayed
    function Current: real; // 1/display_time_of_last_frame (not very steady)
    function Effective: integer; // real amount of really displayed frames in last second (recomended to use this, however it is not very good when FPS is very low (<2))
    function Frames: integer; // Count of frames displayed
    function Duration: integer; // total time in seconds
    function Time: longint; // ingame time in ms
  end;

var
  Fps: TFps;

implementation

{ TFps }

constructor TFps.Create;
begin
  Limit := 20;
  FLimitDelay := 0;
  FLimitLastEffective := 0;
  FStartTime := now;
end;

function TFps.Current: real;
begin
  NoTic;
  result := FCurrent;
end;

function TFps.Duration: integer;
begin
  NoTic;
  result := FDuration;
end;

function TFps.Effective: integer;
begin
  NoTic;
  result := FEffective;
end;

function TFps.Frames: integer;
begin
  NoTic;
  result := FFrames;
end;

procedure TFps.NoTic;
var
  t: TDateTime;
begin
  // update but no tic (like it was not displayed, we just want to know the values)
  t := now;
  if FFirstTime = 0 then
  begin
    FFirstTime := t;
    FLastTime := t;
    FLastLastTime := t;
  end;
  // current
  if t <> FLastLastTime then
    FCurrent := 1 / (t - FLastLastTime) / 86400
  else
    FCurrent := maxint;
  // effective
  if (t - FLastTime) * 86400 > 1 then
  begin
    FEffective := 0; //round(FLastEffective/(t-FLastTime)/96400);
  end;
  // frames and duration
  FDuration := Round((t - FFirstTime) * 86400);
end;

procedure TFps.Tic;
var
  t: TDateTime;
  e: integer;
begin
  // update FPS Counter
  t := now;
  if FFirstTime = 0 then
  begin
    FFirstTime := t;
    FLastTime := t;
    FLastLastTime := t;
  end;
  // current
  if t <> FLastTime then
    FCurrent := 1 / (t - FLastTime) / 86400
  else
    FCurrent := maxint;
  // effective
  if Trunc(t * 86400) = Trunc(FLastTime * 86400) then
    Inc(FLastEffective)
  else
  begin
    FEffective := FLastEffective;
    FLastEffective := 0;
  end;
  // Sleeps
  e := Effective;
  if e <> FLimitLastEffective then
  begin
    if e > Limit then
    begin
      inc(FLimitDelay,2);
      Debug.Msg(dlDetail,'FPS: ld =~ ' + IntToStr(FLimitDelay) + ' e=' + IntToStr(effective) + ' l=' + IntToStr(limit));
    end  else
    begin
      if FLimitDelay > 0 then
      begin
        if FLimitDelay > 0 then
          dec(FLimitDelay,2);
        Debug.Msg(dlDetail,'FPS: ld =~ ' + IntToStr(FLimitDelay));
      end;
    end;
  end;
  FLimitLastEffective := e;
  if FLimitDelay > 0 then
    Sleep(FLimitDelay);
  // frames and duration
  inc(FFrames);
  FDuration := Round((t - FFirstTime) * 86400);
  // remember last time
  FLastLastTime := FLastTime;
  FLastTime := t;
end;

function TFps.Time: longint;
begin
  result := round((Now - FStartTime)*86400000);
end;

initialization

  Fps := TFps.Create;

finalization

  Debug.Msg(dlInfo,'Releasing Fps');
  Fps.Free;

end.
